home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / src / pl-list.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-01-22  |  2.6 KB  |  145 lines
  1. /*  $Id: pl-list.c,v 1.7 1996/01/22 15:17:22 jan Exp $
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: List manipulation predicates in C
  8. */
  9.  
  10. #include "pl-incl.h"
  11.  
  12. word
  13. pl_is_list(term_t list)
  14. { Word p = valTermRef(list);
  15.  
  16.   deRef(p);
  17.  
  18.   if ( isList(*p) || isNil(*p) )
  19.     succeed;
  20.  
  21.   fail;
  22. }
  23.  
  24.  
  25. word
  26. pl_proper_list(term_t list)
  27. { if ( lengthList(list) >= 0 )
  28.     succeed;
  29.  
  30.   fail;
  31. }
  32.  
  33.  
  34. word
  35. pl_length(term_t list, term_t l)
  36. { int n;
  37.  
  38.   if ( PL_get_integer(l, &n) )
  39.   { if ( n >= 0 )
  40.     { term_t h = PL_new_term_ref();
  41.       term_t l = PL_copy_term_ref(list);
  42.  
  43.       while( n-- > 0 )
  44.       { TRY(PL_unify_list(l, h, l));
  45.       }
  46.  
  47.       return PL_unify_nil(l);
  48.     }
  49.     fail;
  50.   }
  51.  
  52.   if ( PL_is_variable(l) )
  53.   { long n;
  54.   
  55.     if ( (n=lengthList(list)) >= 0 )
  56.       return PL_unify_integer(l, n);
  57.  
  58.     fail;            /* both variables: generate in Prolog */
  59.   }
  60.   
  61.   return warning("length/2: instantiation fault");
  62. }  
  63.  
  64.  
  65. word
  66. pl_memberchk(term_t e, term_t list)
  67. { term_t h = PL_new_term_ref();
  68.   term_t l = PL_copy_term_ref(list);
  69.  
  70.   for(;;)
  71.   { TRY(PL_unify_list(l, h, l));
  72.       
  73.     if ( PL_unify(e, h) )
  74.       succeed;
  75.   }
  76. }
  77.  
  78.  
  79. static int
  80. qsort_compare_standard(const void *p1, const void *p2)
  81. { return compareStandard((Word) p1, (Word) p2);
  82. }
  83.  
  84.  
  85. static term_t
  86. list_to_sorted_array(term_t List, int *size)
  87. { int n = lengthList(List);
  88.   term_t rval;
  89.   term_t list = PL_copy_term_ref(List);
  90.   term_t head = PL_new_term_ref();
  91.   int i;
  92.  
  93.   if ( n < 0 )
  94.     fail;            /* not a proper list */
  95.   rval = PL_new_term_refs(n);
  96.   
  97.   for(i=0; PL_get_list(list, head, list); i++)
  98.     PL_put_term(rval+i, head);
  99.  
  100.   qsort(valTermRef(rval), n, sizeof(word), qsort_compare_standard);
  101.   
  102.   *size = n;
  103.   return rval;
  104. }
  105.  
  106.  
  107. word
  108. pl_msort(term_t list, term_t sorted)
  109. { term_t array;
  110.   term_t l = PL_copy_term_ref(sorted);
  111.   term_t h = PL_new_term_ref();
  112.   int n, i;
  113.  
  114.   if ( !(array = list_to_sorted_array(list, &n)) )
  115.     return warning("msort/1: first argument is not a proper list");
  116.   for(i=0; i < n; i++)
  117.   { if ( !PL_unify_list(l, h, l) ||
  118.      !PL_unify(h, array+i) )
  119.       fail;
  120.   }
  121.  
  122.   return PL_unify_nil(l);
  123. }
  124.  
  125.  
  126. word
  127. pl_sort(term_t list, term_t sorted)
  128. { term_t array;
  129.   term_t l = PL_copy_term_ref(sorted);
  130.   term_t h = PL_new_term_ref();
  131.   int n, size;
  132.  
  133.   if ( !(array=list_to_sorted_array(list, &size)) )
  134.     return warning("sort/1: first argument is not a proper list");
  135.   for(n = 0; n < size; n++)
  136.   { if ( n == 0 || !pl_equal(array+n-1, array+n) )
  137.     { if ( !PL_unify_list(l, h, l) ||
  138.        !PL_unify(h, array+n) )
  139.     fail;
  140.     }
  141.   }
  142.  
  143.   return PL_unify_nil(l);
  144. }
  145.